// RealPlay Ltd  copyrights.
// This program is Open Source AsIs
// You may use it for all purposes, including commercial
// But!!!
// If you use any part of this code, you must state clearly
// both in your source file and in the Help|about of your program,
// that the origin program or code was built by RealPlay Ltd

// ***********************************************************************/
// *                                                                     */
// * This unit is the dialog for attributes (Ctrl-E)for  "Paint" Program */
// *                                                                     */
// ***********************************************************************/

unit UPAtr;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TFAtr = class(TForm)
    Label1: TLabel;
    LDate: TLabel;
    Label3: TLabel;
    LSizeOnDisk: TLabel;
    Label5: TLabel;
    LRes: TLabel;
    Label7: TLabel;
    EWidth: TEdit;
    Label8: TLabel;
    EHeight: TEdit;
    GroupBox1: TGroupBox;
    RInches: TRadioButton;
    RCm: TRadioButton;
    RPixels: TRadioButton;
    GroupBox2: TGroupBox;
    RBW: TRadioButton;
    RColors: TRadioButton;
    Button1: TButton;
    Button2: TButton;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FAtr: TFAtr;

procedure PixSize(Dw, Dh: integer);
procedure PixBW;

implementation

uses UPMain, UPMenu;
{$R *.dfm}

procedure TFAtr.FormShow(Sender: TObject);
var
  f: File of byte;
  fs: int64;
  stf: string;
begin
  FormCreate(nil);
  stf := FMenu.OPD1.FileName;
  if fileexists(stf) then
  begin
    LDate.Caption := DateTimeToStr(FileDateToDateTime(FileAge(stf)));
    fs := -1;
    AssignFile(f, stf);
    try
      Reset(f);
      fs := system.FileSize(f);
    finally
      CloseFile(f);
    end;
    if fs <> -1 then
      LSizeOnDisk.Caption := inttostr(fs) + ' Bytes'
    else
      LSizeOnDisk.Caption := 'Error';
  end
  else
  begin
    LSizeOnDisk.Caption := 'Not Available';
    LDate.Caption := 'Not Available';
  end;
  LRes.Caption := inttostr(screen.PixelsPerInch) + ' x ' + inttostr
    (screen.PixelsPerInch) + ' dots per inch';
  if RPixels.Checked then
  begin
    EWidth.Text := inttostr(Fpaint.FWA.Im.Width);
    EHeight.Text := inttostr(Fpaint.FWA.Im.Height);
  end
  else If RInches.Checked then
  begin
    EWidth.Text := FloatToStrF(Fpaint.FWA.Im.Width / screen.PixelsPerInch,
      ffFixed, 5, 2);
    EHeight.Text := FloatToStrF(Fpaint.FWA.Im.Height / screen.PixelsPerInch,
      ffFixed, 5, 2);
  end
  else If RCm.Checked then
  begin
    EWidth.Text := FloatToStrF
      (2.54 * Fpaint.FWA.Im.Width / screen.PixelsPerInch, ffFixed,
      5, 1);
    EHeight.Text := FloatToStrF
      (2.54 * Fpaint.FWA.Im.Height / screen.PixelsPerInch, ffFixed, 5, 1);
  end;
end;

procedure PixSize(Dw, Dh: integer);
begin
  with Fpaint.FWA do
  begin
    ImSelS.ClearSel;
    Im.Picture.Bitmap.Width := Dw;
    Im.Picture.Bitmap.Height := Dh;
    ImPanel.Width := round(Dw / ZoomXr) + IMRightPanel.Width;
    ImPanel.Height := round(Dh / ZoomYr) + IMBottomPanel.Height;
    ZoomXr := Im.Width / Im.Picture.Width;
    MyStat.cx := ZoomXr;
    ZoomYr := Im.Height / Im.Picture.Height;
    MyStat.cy := ZoomYr;
  end;
end;

procedure PixBW;
var
  x, y: integer;
  cl: Tcolor;
  b: byte;
begin
  screen.Cursor := crHourGlass;
  with Fpaint.FWA.Im.Picture.Bitmap do
    for x := 0 to Width - 1 do
      for y := 0 to Height - 1 do
      begin
        cl := canvas.pixels[x, y];
        b := ((cl and $FF) + (cl and $FF00) shr 8 + (cl and $FF0000) shr 16)
          div 3;
        canvas.pixels[x, y] := b + b shl 8 + b shl 16;
      end;
  Fpaint.FWA.MyStat.Changed := true;
end;

procedure TFAtr.Button1Click(Sender: TObject);
var
  i, Dw, Dh: integer;
  fw, fh: real;
begin
  with EWidth do
    for i := 1 to length(Text) do
      if not(Text[i] in ['0' .. '9', '.']) then
        exit;
  with EHeight do
    for i := 1 to length(Text) do
      if not(Text[i] in ['0' .. '9', '.']) then
        exit;
  fw := strtofloat(EWidth.Text);
  fh := strtofloat(EHeight.Text);
  if (fw < 0.2) or (fh < 0.2) then
    exit;
  if RInches.Checked then
  begin
    fw := fw * screen.PixelsPerInch;
    fh := fh * screen.PixelsPerInch;
  end;
  if RCm.Checked then
  begin
    fw := fw * screen.PixelsPerInch / 2.54;
    fh := fh * screen.PixelsPerInch / 2.54;
  end;
  Dw := round(fw);
  Dh := round(fh);
  PixSize(Dw, Dh);
  if RBW.Checked then
    PixBW;

  close;
end;

procedure TFAtr.Button2Click(Sender: TObject);
begin
  close;
end;

procedure TFAtr.FormCreate(Sender: TObject);
begin
  top := Fpaint.top + 60;
  if top + Height + 20 > screen.Height then
    top := screen.Height - Height - 20;
  left := Fpaint.left + 20;
  if left < 20 then
    left := 20;
  if left + Width + 20 > screen.Width then
    left := screen.Width - Width - 20;
end;

end.
